home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 / Ham Radio 2000.iso / ham2000 / packet / thenet / thnet122 / tnp22e.pas < prev    next >
Pascal/Delphi Source File  |  1992-08-16  |  17KB  |  494 lines
  1. {$A+,B-,D+,E-,F-,I-,L-,N-,O-,R-,S-,V+}
  2. {$M 1024,1000,1000}
  3. program tnpatch;
  4.  
  5. uses crt,dos;
  6.  
  7. const
  8.   ParNum = 33;                            (* Anzahl Parameter *)
  9.   panz   : byte = 0;                      (* Anzahl Kommandozeilenparms *)
  10.   auto   : byte = 0;                      (* incl Parameter? *)
  11.  
  12.   prg    = '***** Parameter Patch Program for TheNet 1.22e'+
  13.            ' ****     (V3.2 updated by DG6MAY)';
  14.   space  = '                                  ';
  15.   eprfn  = 'TN122E.BIN';
  16.   signon = 'TheNet 1.22e by DG6MAY';
  17.   len    = 22;                           (* Länge des Signon *)
  18.   clen   = 22;                           (* ctext-länge + space + #0 *)
  19.   qlen   = 21;                           (* quittext-länge + #0 *)
  20.   dlen   = 81;                           (* Textlänge falsches Kommando + #0 *)
  21.  
  22. type
  23.   str68 = string[68];
  24.    ptyp = record                             (* parametertyp *)
  25.             str : string[11];                   (* name des parms für anzeige *)
  26.             adr : word;                         (* adresse im file *)
  27.             wrt : word;                         (* neuer Wert *)
  28.             min : word;                         (* unterer Grenzwert *)
  29.             max : word;                         (* oberer Grenzwert  *)
  30.           end;
  31.  
  32. var
  33.   outfile,infile :  text;
  34.   zeile          :  string[100];
  35.   i,i1,err,wert  :  word;
  36.   pa             :  array [1..ParNum] of ptyp;
  37.   MYID, ALIA     :  string[6];
  38.   PWRD           :  string[80];
  39.   CTXT           :  string[clen];                 (* hallo-text *)
  40.   QTXT           :  string[qlen];                 (* servus *)
  41.   CMDT           :  string[dlen];                 (* falsches Kommandotext *)
  42.   SSID           :  byte;
  43.   MYIDAD, ALIAAD,
  44.   SSIDAD, PWRDAD,
  45.   CTXTAD, QTXTAD,
  46.   CMDTAD         :  word;                         (* adressen *)
  47.   Pgm            :  array [0..32767] of char;
  48.   PCFile         :  string[13];
  49.   ch             :  char;
  50.   crc            :  string[len];
  51.  
  52.  
  53. {--------------------------------------------------------------------------}
  54. procedure clrzeilen;
  55. begin
  56.  if auto=0 then
  57.  begin
  58.    gotoxy(1,25); clreol;
  59.    gotoxy(1,24); clreol;
  60.  end;
  61. end;
  62.  
  63. {--------------------------------------------------------------------------}
  64. procedure help(nr:byte;line: string);
  65. begin
  66.   if auto=0 then gotoxy(1,wherey-2);
  67.   write(#10#13,'Error detected '#7);
  68.   if nr=0 then zeile:='with reading '+line;
  69.   if nr=52 then zeile:='number after ''PA''is wrong';
  70.   if nr=53 then zeile:='something wrong with the value after ''=''';
  71.   if nr=54 then zeile:='value out of range';
  72.   if nr=55 then zeile:='in Patch-File';
  73.   write(zeile);
  74.   if nr > 50 then
  75.   begin
  76.     writeln(' in the following line:');
  77.     writeln(#10#13+line);
  78.   end;
  79.   writeln(#10#10#13'Program haltet');
  80.   halt(nr);
  81. end;
  82. {--------------------------------------------------------------------------}
  83. procedure header;
  84. begin
  85.   clrscr; highvideo; writeln(prg);
  86.   normvideo;
  87.   gotoxy(1,24);
  88. end;
  89. {--------------------------------------------------------------------------}
  90. procedure anzeige (var auto: byte);   (* anzeige auf schirm, feststellen, *)
  91. begin                                 (* ob mit kommandozeilen-parameter  *)
  92.   if paramcount > 1 then
  93.   begin
  94.     auto:=1;
  95.     writeln;
  96.     highvideo;  writeln(prg); lowvideo;
  97.     writeln(#10,'in Automatic-Work ....pse wait ...',#10);
  98.   end
  99.   else header;
  100. end;
  101.  
  102. {--------------------------------------------------------------------------}
  103. procedure readbin;     (* einlesen des binärfiles, suchen nach dem signon *)
  104. begin
  105.  
  106.   writeln('reading: ',eprfn);
  107.   assign(infile,eprfn);
  108.   {$I-}   reset(infile); {$I+}
  109.   i:=ioresult;
  110.   if i <> 0 then help(0,eprfn);
  111.   for i := 0 to 32767 do read(infile,pgm[i]);
  112.   close(infile);
  113.  
  114.   i:=19000;           (* ------- suchen nach dem signon ab dem offset ----*)
  115.   crc[0]:=chr(len);                                (* länge muß klar sein *)
  116.   repeat
  117.     for i1:=1 to len do crc[i1]:=pgm[i+i1];
  118.     inc(i);
  119.   until (crc=signon) or (i>25000);                        (* bis gefunden *)
  120.  
  121.   if i > 25000 then
  122.   begin
  123.     writeln('Signon ''',signon,''' not found !');
  124.     halt(0);
  125.   end;
  126.  
  127. end;
  128.  
  129. {--------------------------------------------------------------------------}
  130. procedure table;
  131. begin
  132.  
  133. pa[01].str:='Max-Nodes  '; pa[01].adr:=$9F; pa[01].min:=1;  pa[01].max:=200;
  134. pa[02].str:='min-Quality'; pa[02].adr:=$A1; pa[02].min:=0;  pa[02].max:=255;
  135. pa[03].str:='HF-Quality '; pa[03].adr:=$A3; pa[03].min:=0;  pa[03].max:=255;
  136. pa[04].str:='RS-Quality '; pa[04].adr:=$A5; pa[04].min:=0;  pa[04].max:=255;
  137. pa[05].str:='Obs-Init   '; pa[05].adr:=$A7; pa[05].min:=0;  pa[05].max:=255;
  138. pa[06].str:='min-BCast  '; pa[06].adr:=$A9; pa[06].min:=0;  pa[06].max:=255;
  139. pa[07].str:='Broadcast  '; pa[07].adr:=$AB; pa[07].min:=0;  pa[07].max:=$FFFF;
  140. pa[08].str:='Lifetime   '; pa[08].adr:=$AD; pa[08].min:=0;  pa[08].max:=255;
  141. pa[09].str:='T-Timeout  '; pa[09].adr:=$AF; pa[09].min:=5;  pa[09].max:=600;
  142. pa[10].str:='T-Retry    '; pa[10].adr:=$B1; pa[10].min:=2;  pa[10].max:=127;
  143. pa[11].str:='T-AckDelay '; pa[11].adr:=$B3; pa[11].min:=1;  pa[11].max:=60;
  144. pa[12].str:='T-BsyDelay '; pa[12].adr:=$B5; pa[12].min:=1;  pa[12].max:=1000;
  145. pa[13].str:='T-Window   '; pa[13].adr:=$B7; pa[13].min:=1;  pa[13].max:=127;
  146. pa[14].str:='NoAckBuf   '; pa[14].adr:=$B9; pa[14].min:=1;  pa[14].max:=127;
  147. pa[15].str:='Timeout    '; pa[15].adr:=$BB; pa[15].min:=30; pa[15].max:=$FFFF;
  148. pa[16].str:='Persistence'; pa[16].adr:=$BD; pa[16].min:=5;  pa[16].max:=255;
  149. pa[17].str:='SlotTime   '; pa[17].adr:=$BF; pa[17].min:=0;  pa[17].max:=255;
  150. pa[18].str:='Frack      '; pa[18].adr:=$93; pa[18].min:=1;  pa[18].max:=15;
  151. pa[19].str:='Maxframe   '; pa[19].adr:=$95; pa[19].min:=1;  pa[19].max:=7;
  152. pa[20].str:='L2-Retry   '; pa[20].adr:=$97; pa[20].min:=1;  pa[20].max:=127;
  153. pa[21].str:='T2-Timer   '; pa[21].adr:=$99; pa[21].min:=0;  pa[21].max:=600;
  154. pa[22].str:='T3-Timer   '; pa[22].adr:=$9B; pa[22].min:=0;  pa[22].max:=$FFFF;
  155. pa[23].str:='L2-Digi    '; pa[23].adr:=$9D; pa[23].min:=0;  pa[23].max:=2;
  156. pa[24].str:='CallCheck  '; pa[24].adr:=$C1; pa[24].min:=0;  pa[24].max:=1;
  157. pa[25].str:='ID-Beacon  '; pa[25].adr:=$C3; pa[25].min:=0;  pa[25].max:=600;
  158. pa[26].str:='CQ-MODE    '; pa[26].adr:=$C5; pa[26].min:=0;  pa[26].max:=3;
  159. pa[27].str:='Full-Duplex'; pa[27].adr:=$C7; pa[27].min:=0;  pa[27].max:=1;
  160. pa[28].str:='Idle-Flags '; pa[28].adr:=$C9; pa[28].min:=0;  pa[28].max:=1;
  161. pa[29].str:='TX-Delay   '; pa[29].adr:=$CB; pa[29].min:=0;  pa[29].max:=127;
  162. pa[30].str:='Systemflags'; pa[30].adr:=$CD; pa[30].min:=0;  pa[30].max:=$FFFF;
  163. pa[31].str:='CCP MinBuff'; pa[31].adr:=$CF; pa[31].min:=250;pa[31].max:=800;
  164. pa[32].str:='SpaceChar  '; pa[32].adr:=$D1; pa[32].min:=0;  pa[32].max:=255;
  165. pa[33].str:='Kaltstart  '; pa[33].adr:=$123;pa[33].min:=0;  pa[33].max:=1;
  166.  
  167. MYID := '';                MYIDAD := $86;
  168. ALIA := '';                ALIAAD := $8D;
  169. SSID := 0;                 SSIDAD := $8C;
  170. PWRD := '';                PWRDAD := $D3;
  171. CTXT := '';                CTXTAD := $4D78;
  172. QTXT := '';                QTXTAD := $4D8E;
  173. CMDT := '';                CMDTAD := $4DE6;
  174.  
  175.  
  176.  
  177. end;
  178.  
  179. {--------------------------------------------------------------------------}
  180.  
  181. procedure getfn(x,y: byte; text: string; var datei: text; modus : byte);
  182. begin
  183.   repeat
  184.     clrzeilen; write(text); gotoxy(x,y);
  185.     PCFile := '';
  186.     repeat
  187.      ch:=upcase(readkey);
  188.      if ((ch > #32) and (ch < #42) and (ch <> #34)) or
  189.         ((ch > #44) and (ch < #58) and (ch <> #47)) or
  190.         ((ch > #64) and (ch < #91)) or
  191.         (ch = #13) or (ch='_') or (ch='\' ) or (ch=#8) then
  192.         begin
  193.           if (ch=#8) then
  194.             if (length(PCFile) > 0) then
  195.             begin
  196.               write(#8#32#8);
  197.               dec(PCFile[0]);
  198.             end
  199.             else write(#7)
  200.           else
  201.           begin
  202.             write(ch);
  203.             PCFile:=PCFile+ch;
  204.           end;
  205.         end
  206.         else write(#7);
  207.     until (ch = #13);
  208.     writeln;
  209.     dec(PCFile[0]);
  210.     if pcfile[0]=#0 then halt;
  211.     if (modus=2) and (pos('.',pcfile)=0) then pcfile:=pcfile+'.BIN';
  212.     assign(datei,PCFile);
  213.     if modus=1 then {$I-}   reset(datei); {$I+}
  214.     if modus=2 then {$I-} rewrite(datei); {$I+}
  215.     i:=ioresult;
  216.     if i <> 0 then write(#7);
  217.   until i=0;
  218. end;
  219.  
  220. {--------------------------------------------------------------------------}
  221.  
  222. procedure readpat;
  223. var str10 : string[10];
  224. begin
  225. clrzeilen; writeln('reading: '+pcfile);
  226. repeat
  227.    readln(infile,zeile);
  228.                                            (* nächste zeile holen, wenn:  *)
  229.    while ((length(zeile) = 0) or           (* nix in der zeile steht *)
  230.           (ord(zeile[1]) < 33) or          (* 1. Zeichen <= space *)
  231.           (ord(zeile[1]) > 90) or          (* größer 'Z' *)
  232.           (zeile[1] = ';')) and            (* ; ist (kommentar)  *)
  233.           not eof(infile) do               (* und no net end of file ist *)
  234.           readln(infile,zeile);
  235.  
  236.  
  237. (**************************************** Call  einlesen *********************)
  238.  
  239.    if copy(zeile,1,4) = 'MYID' then
  240.    begin
  241.      MYID := copy(zeile,6,6);
  242.      MYID := MYID + copy(space,1,6-length(myid));
  243.    end;
  244.  
  245.  
  246. (**************************************** Ident einlesen *********************)
  247.  
  248.    if copy(zeile,1,4) = 'ALIA' then
  249.    begin
  250.      ALIA := copy(zeile,6,6);
  251.      ALIA := ALIA + copy(space,1,6-length(alia));
  252.    end;
  253.  
  254.  
  255. (**************************************** SSID  einlesen *********************)
  256.  
  257.    if copy(zeile,1,4) = 'SSID' then
  258.    begin
  259.      i1:=pos(#32,zeile);                  (* pos in zeile vor einem space *)
  260.      if i1=0 then i1:=length(zeile)       (* wenn kein space, bis zum ende *)
  261.              else dec(i1);                (* sonst bis pos vorher *)
  262.      val(copy(zeile,6,i1-5),ssid,i);
  263.      if (ssid < 0) or (ssid >15) or (i <>0) then help(53,zeile);
  264.    end;
  265.  
  266.  
  267. (**************************************** Password einlesen ******************)
  268.  
  269.    if copy(zeile,1,4) = 'PWRD' then
  270.    begin
  271.      PWRD := copy(zeile,6,80);
  272.      i1 := pos(' ',pwrd);
  273.      if (length(PWRD) < 80 ) or (i1 > 0) then help(55,zeile);
  274.    end;
  275.  
  276.  
  277. (******************************* Begrüßungstext einlesen *********************)
  278.  
  279.    if copy(zeile,1,4) = 'CTXT' then
  280.    begin
  281.      CTXT := copy(zeile,6,20);
  282.      CTXT:=CTXT+#32+#0;
  283.      while(length(CTXT) < clen) do CTXT:=CTXT+#32;      (* sieht im Eprom *)
  284.    end;                                                 (* besser aus! *)
  285.  
  286.  
  287. (******************************* 'Servus'-Text  einlesen *********************)
  288.  
  289.    if copy(zeile,1,4) = 'QTXT' then
  290.    begin
  291.      QTXT := copy(zeile,6,20);
  292.      QTXT:=QTXT+#0;
  293.      while(length(QTXT) < qlen) do QTXT:=QTXT+#32;      (* sieht im Eprom *)
  294.    end;                                                 (* besser aus! *)
  295.  
  296.  
  297. (********************* Text 'falsches Kommando' einlesen *********************)
  298.  
  299.    if copy(zeile,1,4) = 'CMDT' then
  300.    begin
  301.      CMDT := copy(zeile,6,80);
  302.      while(length(CMDT) < dlen-1) do CMDT:=CMDT+#32;    (* sonst gibts prob. *)
  303.      CMDT:=CMDT+#0;                                     (* da text in CTEXT *)
  304.      for i:=1 to dlen do
  305.        if CMDT[i]='\' then CMDT[i]:=#13;
  306.    end;
  307.  
  308.  
  309. (*********************************** Parameter  einlesen *********************)
  310.  
  311.    if (copy(zeile,1,2) = 'PA') then
  312.      begin
  313.        val(copy(zeile,3,2),i,err);
  314.        if (err<>0) or (i<0) or (i>parnum) then help(52,zeile);
  315.        i1:=pos(#32,zeile);                  (* pos in zeile vor einem space *)
  316.        if i1=0 then i1:=length(zeile)       (* wenn kein space, bis zum ende *)
  317.               else dec(i1);                 (* sonst bis pos vorher *)
  318.        str10:=copy(zeile,6,i1-5);           (* rüberkopieren *)
  319.        val(str10,wert,err);                 (* auswerten *)
  320.        if err <> 0 then help(53,zeile);     (* Fehler erkannt? *)
  321.        with pa[i] do
  322.        begin
  323.          if (wert < min) or (wert > max) then help(54,zeile);
  324.          wrt:=wert;
  325.        end;
  326.      end;
  327.  
  328. until eof(infile);
  329.  
  330. close(infile);
  331.  
  332. end;
  333.  
  334. {--------------------------------------------------------------------------}
  335.  
  336. procedure showparms;
  337. var   x,y : byte; hstr : string[3];
  338.       cstr, qstr, xstr : string[100];
  339. begin
  340.   y:=3;
  341.   gotoxy(1,y); write('Ident: ');
  342.   highvideo;   write(ALIA);
  343.   normvideo;   write('  Call: ');
  344.   highvideo;   write(MYID);
  345.   normvideo;   write('  SSID: ');
  346.   highvideo;   writeln(SSID);
  347.   normvideo;
  348.   inc(y,2);
  349.  
  350.   for i:=1 to Parnum do
  351.   begin
  352.      x:=((i-1) mod 3) * 28+1;
  353.      if i < 10 then inc(x);
  354.      gotoxy(x,y);
  355.      with pa[i] do
  356.        write(i,'  ',str,'  ',wrt);
  357.     if (i mod 3) = 0 then inc(y);
  358.   end;
  359.  
  360.   (*------------------------------------ formen der Bits ---------- *)
  361.   i1:=pa[30].wrt; i:=32768; y:=15; zeile:='';
  362.   repeat
  363.    if (i1 >= i) then
  364.    begin
  365.      str(y,hstr);
  366.      zeile:=#32+hstr+zeile;
  367.      i1:=i1-i;
  368.    end;
  369.    dec(y);
  370.    i:=i shr 1;
  371.   until y = 255;
  372.   (*----------------------------------------------------------------- *)
  373.  
  374.   y:=10;
  375.   if length(zeile) > y then
  376.      while (zeile[y] <> ' ' ) do dec(y);
  377.  
  378.   writeln(#10#13);
  379.   writeln('Pwd:  ',copy(PWRD, 1,40),'   Flags set by Parm30:',copy(zeile,1,y));
  380.   writeln('      ',copy(PWRD,41,40),'   ',copy(zeile,y+1,255));
  381.  
  382.   writeln;
  383.  
  384.   cstr:=(copy(ctxt,1,(pos(#0,ctxt)-1)));
  385.   qstr:=(copy(qtxt,1,(pos(#0,qtxt)-1)));
  386.   xstr:=(copy(cmdt,1,(pos(#0,cmdt)-1)));
  387.  
  388.   writeln('CTXT: ''',cstr,'''     QTXT: ''',qstr,'''',#10#13);
  389.   write  ('CMDT: ''');
  390.   while(xstr[length(xstr)]=' ') do dec(xstr[0]);
  391.   for i:=1 to length(xstr) do
  392.     if xstr[i] = #13 then
  393.     begin
  394.      highvideo; write ('\'); normvideo;
  395.     end
  396.     else write (xstr[i]);
  397.   writeln('''');
  398.  
  399. end;
  400.  
  401. {--------------------------------------------------------------------------}
  402.  
  403. procedure change;
  404. begin
  405.  
  406.   for i := 1 to 6 do pgm[MYIDAD+i-1] := MYID[i];
  407.  
  408.   pgm[SSIDAD] := Chr(2*(SSID+48));
  409.  
  410.   for i := 1 to 6  do pgm[ALIAAD+i-1] := ALIA[i];
  411.   for i := 1 to 80 do pgm[PWRDAD+i-1] := PWRD[i];
  412.   if CTXT > '' then
  413.     for i := 1 to length(CTXT) do pgm[CTXTAD+i-1] := CTXT[i];
  414.   if QTXT > '' then
  415.     for i := 1 to length(QTXT) do pgm[QTXTAD+i-1] := QTXT[i];
  416.   if CMDT > '' then
  417.     for i := 1 to length(CMDT) do pgm[CMDTAD+i-1] := CMDT[i];
  418.  
  419.  
  420.   for i := 1 to 32 do
  421.   begin
  422.     pgm[pa[i].adr]   := Chr(pa[i].wrt);
  423.     pgm[pa[i].adr+1] := Chr(trunc( pa[i].wrt / 256));
  424.   end;
  425.   pgm[pa[33].adr]:=chr(pa[33].wrt);                       (* dies ist nur 1 Byte ! *)
  426.  
  427. end;
  428.  
  429. {--------------------------------------------------------------------------}
  430.  
  431. procedure writebin;
  432. begin
  433.   clrzeilen;
  434.   writeln('saving: ',PCFile);
  435.   for i := 0 to 32767 do write(outfile,pgm[i]);
  436.   close(outfile);
  437. end;
  438.  
  439.  
  440. {--------------------------------------------------------------------------}
  441.  
  442. procedure work;
  443. begin
  444.   if auto=1 then   (*--------- aufruf mit kommando-zeilen-parameter ------*)
  445.   repeat                                          (* zähler der parameter *)
  446.     inc(panz);
  447.     if paramcount >= panz then                    (* gibt noch welche *)
  448.     begin
  449.      pcfile:=paramstr(panz);                      (* zuerst patchfilename *)
  450.      assign(infile,pcfile);
  451.      {$I-} reset(infile); {$I+}
  452.      i:=ioresult;
  453.      if i<>0 then halt;                           (* fehler *)
  454.     end;
  455.     readpat;                                      (* patchfile lesen *)
  456.     change;                                       (* und epromarray ändern *)
  457.     inc(panz);
  458.     if paramcount >= panz then
  459.     begin
  460.       pcfile:=paramstr(panz);
  461.       if pos('.',pcfile)=0 then pcfile:=pcfile+'.bin';
  462.       assign(outfile,pcfile);
  463.       {$I-} rewrite(outfile); {$I+}
  464.       i:=ioresult;
  465.       if i <> 0 then halt;
  466.     end;
  467.     writebin;
  468.   until panz > (Paramcount-2)
  469.  
  470.   else (*------------------------ hier also manuell ------------*)
  471.   repeat
  472.  
  473.     getfn(32,24,'Enter Patch Control File Name:'+#10+#13+
  474.                 '(Exit if only <CR>)',infile,1);
  475.     readpat;
  476.     showparms;
  477.     change;
  478.     getfn(39,24,'Enter name of the binary output file:'+#10+#13+
  479.                 '(Exit if only <CR>)',outfile,2);
  480.     writebin;
  481.     header;
  482.   until 1=2;
  483.  
  484. end;
  485.  
  486. {--------------------------------------------------------------------------}
  487.  
  488. Begin
  489.  anzeige(auto);
  490.  readbin;
  491.  table;
  492.  work;
  493. End.
  494.